Apple II Magazines (PO)/Nibble Volume 09, No. 10 (1988-10)(MicroSPARC)(Side A).zip/Nibble Volume 09, No. 10 (1988-10)(MicroSPARC)(Side A).po/AUA.S

Text File | 1996-12-24 | 14KB | 383 lines

*                     AUA Source Code                     *
*                   by Dean M. Pickering                  *
*                    Copyright (C) 1988                   *
*                    by MicroSPARC, Inc                   *
*                    Concord, MA  01742                   *
*                                                         *
*                 Assembler:  EDASM.SYSTEM                *
*
* The code is relocatable and may be attached to the end of
* BASIC programs to avoid reserving space.
MAIN      EQU $06 Main width before point
DEC       EQU $07 No.of decimal places
LENGTH    EQU $08 LEN of digit string
COMMAS    EQU $09 Commas flag
DOLLAR    EQU $18 Flag for dollar sign
PROMPT    EQU $33 Prompt character held here
VARADDR   EQU $85 Addr of var to be moved
BASEND    EQU $AF BASIC load end is in $AF,B0
CHARGET   EQU $B1 BASIC input - get next char
CHARGOT   EQU $B7 BASIC input - get curr. char
ERRFLAG   EQU $D8 Neg if ONERR active
STACK     EQU $DF Stack pointer saved here
SAVEFLAG  EQU $E3 Temporary for error flag
AMPER     EQU $03F5 Ampersand jump vector
*   Use lots of ROM subroutines - saves code
FNDLN     EQU $D61A Get addr of Line in $50,51
CLRHIGH   EQU $D539 Strip high bits in inp buffer
RESTART   EQU $D7D2 Re-start prog after error
LINEADDR  EQU $D941 Set $B8,B9 to line in $50,51
UNDEFD    EQU $D97C UNDEF'D ERROR exit
SKIP      EQU $D995 Move $B8,9 to next colon/null
ADDON     EQU $D998 Add Y to pointer $B8,B9
MOVEPTR   EQU $DA9A Instal ptr in var in $85,86
PRINTCR   EQU $DAFB Print carriage return
PRINTSTR  EQU $DB3A Print string from Y,A to null
PRINTA    EQU $DB5C Print accumulator
EVAL      EQU $DD67 Eval input into FP reg (FP1)
CONFMSTR  EQU $DD6C Confirm variable is string
COMMA     EQU $DEBE Confirm comma next
CHECKA    EQU $DEC0 Confirm next = Acc
SYNTAX    EQU $DEC9 SYNTAX ERROR exit
FINDVAR   EQU $DFE3 Address of variable into Y,A
POINTER   EQU $E3E7 Establ. str ptr in ZP stack
MOVESTR   EQU $E3E9 Move str to string space
LENA      EQU $E600 Pop ZP stack, LEN in Acc
GETX1     EQU $E6F8 Evaluate input into X
GETX2     EQU $E74C Check comma, eval inp into X
CONVBIN   EQU $E752 Convert FP1 to bin in $50,51
ADD       EQU $E7BE Add val at Y,A to FP1
MULT      EQU $E97F Mult FP1 by val at Y,A
SIGN      EQU $EB82 Get sign of FP1 (FF,0, or 1)
ABS       EQU $EBAF Convert FP1 val to ABS
COMP      EQU $EBB2 Compare FP1 with val at Y,A
INT       EQU $EC23 Convert FP1 to INT
STR       EQU $ED34 Make STR$(FP1) at $0100
PRBL2     EQU $F94A MONITOR - print X blanks
GETLN1    EQU $FD6F Get input str in input buffer
BELL      EQU $FF3A MONITOR - ring bell
*
          ORG $2000 Arbitrary, relocatable.
*
* Identify keyword and confirm validity
*
START     LDA ERRFLAG Save ONERR flag. It may be
          STA SAVEFLAG  on or off
          CLC Turn off ONERR to trap errors
          ROR ERRFLAG  in these routines
          JSR CHARGOT Get current char after "&"
          CMP #$84 Is it INPUT token?
          BEQ INPUT Yes - jump and process it
          CMP #$AE Is it RESTORE token?
          BEQ RESTORE Yes - process
          CMP #$A6 Is it RESUME token?
          BEQ RESUME Yes - process
          CMP #$BA Is it PRINT token?
          BEQ USING1 Yes - process
ERROR     JMP SYNTAX Not recognised - error exit
*
* Process & INPUT <str.var>
*
INPUT     JSR CHARGET Skip INPUT token
          JSR FINDVAR Addr of input var into Y,A
          JSR CONFMSTR SYNTAX ERR if not str var
          STA VARADDR Save address for JSR MOVEPTR
          STY VARADDR+1  later
          LDX #$80 Tell BAS.SYS not to send C/R
          STX PROMPT  to screen if input from file
          LDA SAVEFLAG Restore ONERR flag to entry
          STA ERRFLAG  state
          JSR GETLN1 Assemble str in inp buffer
          JSR CLRHIGH Strip high bits, add end zero
          TAX X=0 (term chr in JSR MOVEPTR)
          INY Y,A=$0200, start of string
          JSR MOVESTR Move str to bot of str space,
          JSR MOVEPTR  move ptr to var in $85,86
          RTS Return to BASIC
*
* Process & RESTORE <expression>
*
RESTORE   JSR CHARGET Advance $B8,B9 to next char
          LDA #$AB $AB is the token for GOTO
          JSR CHECKA Confirm that GOTO follows
          JSR EVAL Evaluate line No. into FP1
          JSR CONVBIN Move No. from FP1 to $50,51
          JSR FNDLN Get line address in $9B,9C
          BCS LINEOK C=1 if line exists
          JMP UNDEFD No, exit "UNDEF'D STATEMENT"
LINEOK    LDY $9C Get line address from $9B,9C
          LDX $9B  and deduct 1 to obtain the
          BNE DECLOW  address of the zero byte
          DEY  preceding the new line
DECLOW    DEX
          STX $7D Move address to $7D,7E
          STY $7E  (next data to be read)
          LDA SAVEFLAG Restore ONERR flag to entry
          STA ERRFLAG  state
          RTS Return to BASIC
USING1    BEQ USING Branch range extender
*
* First keyword was RESUME.  Was it NEXT or GOTO?
*
RESUME    JSR CHARGET Get next prog character
          CMP #$82 Is it NEXT?
          BEQ NEXT Branch if it is
          CMP #$AB Is it GOTO?
          BNE ERROR Crash if neither
*
* The statement was RESUME GOTO.
*
GOTO      LDX STACK Fix stack to pre-error
          TXS
          JSR CHARGET Advance pointer past token
          JSR EVAL Eval linenum into FP reg
          JSR CONVBIN Move it into $50,51
          JSR LINEADDR Set $B8,B9 to start of line
          BNE SETONERR Always (A= $B9)
*
* The statement was RESUME NEXT.
*
NEXT      LDA $DA Replace current line
          STA $75  number with that of the
          LDA $DB  line where the error
          STA $76  occurred
          LDA $DC Restore program pointer
          STA $B8  to address of start of
          LDA $DD  error statement
          STA $B9
          LDX $DF Restore stack to pre-error
          TXS  condition
          JSR CHARGOT Current char is colon or zero
          BNE ADVANCE If zero, skip 4 line header
          LDY #4  bytes before statement
          JSR ADDON  (could be $00 or $3A)
ADVANCE   JSR CHARGET Skip colon or zero
          JSR SKIP Skip current (err) statement
SETONERR  LDA SAVEFLAG Restore ONERR flag
          STA ERRFLAG  to entry condition
          JMP RESTART Resume execution
*
* Process & PRINT [$] [,] M,D,<expression>
*
USING     LDA #00
          STA COMMAS Initialise comma flag
          STA DOLLAR  and dollar flag
          JSR CHARGET Advance $B8,B9 past PRINT
          CMP #$24 Is it a "$" sign?
          BNE CHKCOM No, try for a comma
          STA DOLLAR Set dollar flag
          JSR CHARGET  and move on to next char
CHKCOM    CMP #$2C Is it a thousand comma?
          BNE NOCOMMA No commas
          DEC COMMAS Set comma flag to #$FF
          JSR CHARGET  and move on to next char
NOCOMMA   JSR GETX1 Get M into X (Main width)
          STX MAIN Save M in $06
          JSR GETX2 Confirm comma, get D in X
          STX DEC Save No.dec digits in $07
          JSR COMMA Confirm comma next
GETVAL    JSR EVAL Get val to print, in FP1
          LDX DEC Get D
LOOP1     DEX Decrement D until
          BMI ROUND  negative
          TXA  and save
          PHA  current value
          LDA #$50 $EA50 is address of
          LDY #$EA  constant 10 decimal
          JSR MULT Mult FP1 by 10, D times
          PLA Recover current val
          TAX
          BPL LOOP1 Repeat (always)
ROUND     JSR SIGN Get sign of FP1 in Acc
          PHA Save it
          JSR ABS Convert FP1 to ABS val
          LDA #$64 $EE64 is address of
          LDY #$EE  constant 0.5
          JSR ADD Add 0.5 for rounding
          JSR INT Convert FP1 to its INT
          LDA #$0F $ED0F is address of
          LDY #$ED  constant 999999999
          JSR COMP Comp FP1 with limit in Y,A
          BEQ STRING OK if Acc is -1 or 0
          BPL OVERFL1 Overflow if Acc =1
*
*   Right shift and add leading zeros if value less than 1
*
STRING    JSR STR STR$(FP1) starting at $0100
          JSR POINTER Establ pointer in ZP stack
          JSR LENA Pop stack, LEN in Acc
ZEROS     TAY Save LEN (No. of digits)
          TAX
          DEX Deduct 1
          CPX DEC Leading 0's needed if L-1<D
          BGE PRSPACE Jump if none
SHIFT     LDA $0100,Y Shift string (Y chars)
          STA $0101,Y  to right
          DEY Dec Y until neg.
          BPL SHIFT Shift L chars + terminal 0
          LDA #$30 Insert leading "0"
          STA $0100  in 1st char position
          INX LEN
          INX LEN+1 for each zero added
          TXA
          BNE ZEROS Repeat (always)
PRSPACE   STY LENGTH Final LEN in $08
*
* Find No. commas if wanted, store in $09 with high bit set
*
          BIT COMMAS Neg if commas wanted
          BPL LEADBLK Jump if no commas
          TYA Current length into A
          SEC
          SBC DEC A is No. of int digits
          LDX #$80 Clear low bits initially
          CMP #$4 One comma if 4 or more digs
          BLT STORECOM None if less than 4 digits
          INX $81 for 1 comma
          CMP #$7 Another if 7 or more digits
          BLT STORECOM No, only one comma
          INX $82 for two commas
STORECOM  STX COMMAS Set number of commas
*
*     Increment length in $08 for commas
*
          TXA Move it into A
          AND #$0F Trim off neg bit
          CLC
          ADC LENGTH Add No. of commas to length
          STA LENGTH  in $08
          BNE LEADBLK Always
GETVAL1   BNE GETVAL Branch range extender
OVERFL1   BPL OVERFL2 Branch range extender
*    Print leading blanks for padding
*
LEADBLK   LDA MAIN Get main width M
          BEQ NOLEAD No lead blanks if M = 0
          CLC
          ADC DEC A=M+D
          CLC Deduct extra 1 for sign
          SBC LENGTH A=M+D-L-1
          LDX DOLLAR Do we need a dollar sign?
          BEQ NUMBLK No
          SEC
          SBC #1 Yes, 1 less blank
NUMBLK    TAX X= No. of leading blanks
          BEQ NOLEAD Jump if none
          BMI OVERFLOW Overflow if negative No.
          JSR PRBL2 Print X blanks
*
*     Print sign unless M = 0 and value positive
*
NOLEAD    LDY #$2D Minus sign
          PLA Recover sign (-1,0 or 1)
          BMI ADDSIGN Always printed if neg
          LDY #$20 Substitute space if pos or 0
          LDX MAIN Is M = 0?
          BEQ PRTDOLL No sign space if M = 0
ADDSIGN   TYA Print sign (- or space)
          JSR PRINTA
*
*     Print dollar sign if requested
*
PRTDOLL   LDA DOLLAR Do we print a "$"?
          BEQ DIGITS No
          JSR PRINTA Yes
*
*     Print digits, commas and point where appropriate
*
DIGITS    LDA LENGTH Get L
          SEC
          SBC DEC LEN-D =No. int digs + commas
          TAX Save in X
          LDY #00
PRINTM    CPX #8 Maybe comma at 8th position
          BNE TRYFOUR  before dec point
          LDA #$2 Will there be 2 commas?
          AND COMMAS Yes if 2 bit present
          BNE PRTCOM Print mil comma (X=8, $09=2)
TRYFOUR   CPX #4 Try 4th position
          BNE NEXTDIG No comma, get real digit
          LDA #$3 Thousands comma if
          AND COMMAS  X=4 and $09=1 or 2
          BEQ NEXTDIG Jump if not
PRTCOM    LDA #$2C Load a comma
          BNE PRTCHAR Print it
OVERFL2   BPL OVERFLOW Branch range extender
GETVAL2   BNE GETVAL1 Branch range extender
NEXTDIG   LDA $0100,Y Print main digits (and comms
          INY  if specd) until Y = LEN-D
PRTCHAR   JSR PRINTA Print digit or comma
          DEX X is total number of chars
          BNE PRINTM  before dec. point
          LDA DEC No. dec digits
          BEQ NEXTITEM Next item if no decimals
          LDA #$2E  else print point
          JSR PRINTA  after int digits
          TYA A=low byte start of dec digs
          LDY #$01 YA is start of dec digits
          JSR PRINTSTR Prnt string from Y,A to null
*
*     Item printed - see if another follows
*
NEXTITEM  JSR CHARGOT Get char after item printed
          BEQ YESCR Carriage return and exit if
          CMP #$3A  null byte or colon
          BEQ YESCR
          LDA #$3B Semicolon
          JSR CHECKA Confirm ";" else Syntax Err
          JSR CHARGOT Get char after ";"
          BEQ END Return without C/R if null
          CMP #$3A  or colon after ";"
          BEQ END
          BNE GETVAL2 Else more values to print
YESCR     JSR PRINTCR Print C/R
END       LDA SAVEFLAG Restore ONERR flag to entry
          STA ERRFLAG  state
          RTS Return to BASIC
*
*  Overflow routine prints "O/F" and leading and trailing
*  blanks to maintain spacing. If no decimal places were
*  specified (D=0), then only "OF" is printed.
*
OVERFLOW  PLA Pull sign, discard
          LDX MAIN Original M
          DEX
          DEX M-2 blanks to print
          BEQ PRTO Jump if none
          BMI PRTO Always O/F if M =1 (illegal)
          JSR PRBL2 Print X blanks
PRTO      LDA #$4F
          JSR PRINTA Print "O"
          LDX DEC No. decimals
          BEQ PRTF Jump if none
          LDA #$2F
          JSR PRINTA Print "/"
PRTF      LDA #$46
          JSR PRINTA Print "F"
          LDX DEC No. decimals
          BEQ END2 Jump if none
          JSR PRBL2  else fill with blanks
END2      JSR BELL Blow the whistle
          BNE NEXTITEM Get next item to print
*
* Initiating routine if code is attached to BASIC.
*
INIT      LDA #$4C Set ampersand vector at $03F5
          STA AMPER  for jump to start
          SEC Vector address is end of
          LDA BASEND  BASIC program given by
          SBC #>CODELEN  $AF,B0 minus the length
          STA AMPER+1  of the appended code
          LDA BASEND+1
          SBC #<CODELEN
          STA AMPER+2
          RTS Vector setup complete
DEDUCT    DFB LOADEND-INIT PEEK here to find INIT
*
* That is the end of the code.  The next two lines are
* used by the assembler to calculate its length.
*
LOADEND   EQU * This point given by $AF,B0
CODELEN   EQU LOADEND-START Total code length
          LST OFF,NOA,NOV Kill the symbol table